C----------------------------------------------------------------------------

C Module name: colour naming scheme.

C Author: W.T. Hewitt.

C Function: provides an English-based interface for defining colour values.

C Hashtables used: "colourindex".

C Modification history: (Version), (Date), (Name), (Description).

C 1.0, ?????, W.T. Hewitt, First version.

C 2.0, 8th April 1991, J.G. Williams, Converted from FORTRAN to C.

C----------------------------------------------------------------------------

       SUBROUTINE ptkf_hsltorgb(hsl, rgb)
C /*
C ** \parambegin
C ** \param{REAL}{hsl(3)}{HSL triplet}{IN}
C ** \param{REAL}{rgb(3)}{RGB triplet}{IN}
C ** \paramend
C ** \blurb{This function converts from the HSL double-ended hexcone 
C ** model to the 
C ** RGB model. Given HSL, the equivalent RGB parameters are computed.
C ** All parameters are assumed to be in the range 0.0 to 1.0. The
C ** algorithm is adapted from~\cite{foley:fic}.}
C */
       REAL hsl(3), rgb(3)
       external ptk_hsltorgb !$PRAGMA C(ptk_hsltorgb)

       call ptk_hsltorgb(hsl, rgb)

       RETURN
       END

       SUBROUTINE ptkf_rgbtohsl(rgb, hsl)
C /*
C ** \parambegin
C ** \param{REAL}{rgb(3)}{RGB triplet}{IN}
C ** \param{REAL}{hsl(3)}{HSL triplet}{IN}
C ** \paramend
C ** \blurb{This function converts an RGB triplet to a HSL triplet.
C ** The
C ** algorithm is adapted from~\cite{watt:fotdcg}.}
C */
       REAL rgb(3), hsl(3)
       external ptk_rgbtohsl !$PRAGMA C(ptk_rgbtohsl)

       call ptk_rgbtohsl(rgb, hsl)

       RETURN
       END

       SUBROUTINE ptkf_hsvtorgb(hsv, rgb)
C /*
C ** \parambegin
C ** \param{REAL}{hvs(3)}{HSV triplet}{IN}
C ** \param{REAL}{rgb(3)}{RGB triplet}{IN}
C ** \paramend
C ** \blurb{This function converts a HSV triplet to a RGB triplet. 
C ** The
C ** algorithm is adapted from~\cite{watt:fotdcg}.}
C */
       REAL hsv(3), rgb(3)
       external ptk_hsvtorgb !$PRAGMA C(ptk_hsvtorgb)

       call ptk_hsvtorgb(hsv, rgb)

       RETURN
       END

       SUBROUTINE ptkf_rgbtohsv(rgb, hsv)
C /*
C ** \parambegin
C ** \param{REAL}{rgb(3)}{RGB triplet}{IN}
C ** \param{REAL}{hsv(3)}{HSV triplet}{IN}
C ** \paramend
C ** \blurb{This function converts an RGB value to a HSV value.
C ** The
C ** algorithm is adapted from~\cite{watt:fotdcg}.}
C */
       REAL rgb(3), hsv(3)
       external ptk_rgbtohsv !$PRAGMA C(ptk_rgbtohsv)

       call ptk_rgbtohsv(rgb, hsv)

       RETURN
       END

       LOGICAL FUNCTION ptkf_cnstorgb(colourname, rgb)
C /*
C ** \parambegin
C ** \param{CHARACTER*(*)}{colourname}{colour description}{IN}
C ** \param{REAL}{rgb(3)}{RGB triplet}{IN}
C ** \paramend
C ** \blurb{This function converts a CNS colour name to the equivalent
C **  RGB value, returning TRUE if the conversion was successful,
C ** and FALSE if not.}
C */
       CHARACTER*(*) colourname
       REAL rgb(3)
       LOGICAL*1 ptk_cnstorgb, ans
       external ptk_cnstorgb !$PRAGMA C(ptk_cnstorgb)

       ans = ptk_cnstorgb(colourname, rgb)
       if (ans .eq. 1) then
          ptkf_cnstorgb = .TRUE.
       else
          ptkf_cnstorgb = .FALSE.
       endif

       RETURN
       END

       LOGICAL FUNCTION ptkf_cnstohsl(colourname, hsl)
C /*
C ** \parambegin
C ** \param{CHARACTER*(*)}{colourname}{colour description}{IN}
C ** \param{Pcobundl *}{hsl}{HSL triplet}{IN}
C ** \paramend
C ** \blurb{This function converts a CNS colour name to the equivalent
C **  HSL value, returning TRUE if the conversion was successful,
C ** and FALSE if not.}
C */
       CHARACTER*(*) colourname
       REAL hsl(3)
       LOGICAL*1 ptk_cnstohsl, ans
       external ptk_cnstohsl !$PRAGMA C(ptk_cnstohsl)

       ans = ptk_cnstohsl(colourname, hsl)
       if (ans .eq. 1) then
          ptkf_cnstohsl = .TRUE.
       else
          ptkf_cnstohsl = .FALSE.
       endif

       RETURN
       END

       LOGICAL FUNCTION ptkf_cnstohsv(colourname, hsv)
C /*
C ** \parambegin
C ** \param{CHARACTER*(*)}{colourname}{colour description}{IN}
C ** \param{REAL}{hsv(3)}{HSV triplet}{IN}
C ** \paramend
C ** \blurb{This function Converts colour name to HSV.
C ** Returns TRUE if ok, FALSE if not ok.}
C */
       CHARACTER*(*) colourname
       REAL hsv(3)
       LOGICAL*1 ptk_cnstohsv, ans
       external ptk_cnstohsv !$PRAGMA C(ptk_cnstohsv)

       ans = ptk_cnstohsv(colourname, hsv)
       if (ans .eq. 1) then
          ptkf_cnstohsv = .TRUE.
       else
          ptkf_cnstohsv = .FALSE.
       endif

       RETURN
       END

       SUBROUTINE ptkf_setcnsdefaults(lightness, saturation)
C /*
C ** \parambegin
C ** \param{INTEGER}{lightness}{default lightness for colours}{IN}
C ** \param{INTEGER}{saturation}{default saturation for colours}{IN}
C ** \paramend
C ** \blurb{This function sets default values for lightness and
C **  saturation for the  Colour Naming
C ** Scheme. If lightness or saturation is missing when a 
C ** colour name is subsequently specified, the
C ** default is used.}
C */
       INTEGER lightness, saturation
       external ptk_setcnsdefaults !$PRAGMA C(ptk_setcnsdefaults)

       call ptk_setcnsdefaults(%val(lightness), %val(saturation))

       RETURN
       END

       SUBROUTINE ptkf_inqcnsdefaults(lightness, saturation)
C /*
C ** \parambegin
C ** \param{INTEGER}{lightness}{default lightness for colours}{OUT}
C ** \param{INTEGER}{saturation}{default saturation for colours}{OUT}
C ** \paramend
C ** \blurb{This function inquires the
C **  default values of lightness and saturation used in the  Colour
C ** Naming Scheme.}
C */
       INTEGER lightness, saturation
       external ptk_inqcnsdefaults !$PRAGMA C(ptk_inqcnsdefaults)

       call ptk_inqcnsdefaults(lightness, saturation)

       RETURN
       END

       SUBROUTINE ptkf_setcolourrep(wsid, colourname)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{CHARACTER*(*)}{colourname}{colour name}{IN}
C ** \paramend
C ** \blurb{This function sets a colour representation in 
C ** the colour table of workstation \pardesc{wsid},
C **  using {\tt colourname}.
C ** The hashstrings table
C ** {\t "colourindex"} is used to derive the index to the colour table.}
C */
       INTEGER wsid
       CHARACTER*(*) colourname
       external ptk_setcolourrep !$PRAGMA C(ptk_setcolourrep)

       call ptk_setcolourrep(%val(wsid), colourname)

       RETURN
       END

       SUBROUTINE ptkf_setrgbcolourname(colourname, rgb)
C /*
C ** \parambegin
C ** \param{CHARACTER*(*)}{colourname}{colour name}{IN}
C ** \param{REAL}{rgb(3)}{RGB colour value}{IN}
C ** \paramend
C ** \blurb{This function sets a colour representation in 
C ** CNS using the colour name and
C ** RGB value. The colour name must be different to the names provided by
C ** the CNS. This function enables be  additional names for colours to
C ** be specified in addition to those provided by CNS.}
C */
       CHARACTER*(*) colourname
       REAL rgb(3)
       external ptk_setrgbcolourname !$PRAGMA C(ptk_setrgbcolourname)

       call ptk_setrgbcolourname(colourname, rgb)

       RETURN
       END

       SUBROUTINE ptkf_setbackgroundcolourind(wsid, index)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{INTEGER}{index}{colour index}{IN}
C ** \paramend
C ** \blurb{This function sets the colour representation of the
C **  zeroth entry in the
C ** colour table of workstation \pardesc{wsid}, to be same as the
C **  entry \pardesc{index} in the colour table.}
C */
       INTEGER wsid, index
       external ptk_setbackgroundcolourind 
& !$PRAGMA C(ptk_setbackgroundcolourind)

       call ptk_setbackgroundcolourind(%val(wsid), %val(index))

       RETURN
       END

       SUBROUTINE ptkf_setbackgroundcolour(wsid, colourname)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{CHARACTER*(*)}{colourname}{colour name}{IN}
C ** \paramend
C ** \blurb{This function sets the colour representation of the
C **  zeroth entry in the
C ** colour table of workstation \pardesc{wsid}, to be that
C ** specified by \pardesc{colourname} in the CNS.}
C */
       INTEGER wsid
       CHARACTER*(*) colourname
       external ptk_setbackgroundcolour 
& !$PRAGMA C(ptk_setbackgroundcolour)

       call ptk_setbackgroundcolour(%val(wsid), colourname)

       RETURN
       END

       SUBROUTINE ptkf_setlinecolour(wsid, colourname)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{CHARACTER*(*)}{colourname}{colour name}{IN}
C ** \paramend
C ** \blurb{This function sets the polyline colour index to be 
C ** that specified by the given
C ** colour name in the {\tt "colourindex"} hashtable. The colour 
C ** representation
C ** is set in the workstation colour table if necessary.}
C */
       INTEGER wsid
       CHARACTER*(*) colourname
       external ptk_setlinecolour !$PRAGMA C(ptk_setlinecolour)

       call ptk_setlinecolour(%val(wsid), colourname)

       RETURN
       END

       SUBROUTINE ptkf_setmarkercolour(wsid, colourname)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{CHARACTER*(*)}{colourname}{colour name}{IN}
C ** \paramend
C ** \blurb{This function sets the polymarker colour index to be 
C ** that specified by the given
C ** colour name in the {\tt "colourindex"} hashtable. The colour 
C ** representation is set in the workstation colour table if necessary.}
C */
       INTEGER wsid
       CHARACTER*(*) colourname
       external ptk_setmarkercolour !$PRAGMA C(ptk_setmarkercolour)

       call ptk_setmarkercolour(%val(wsid), colourname)

       RETURN
       END

       SUBROUTINE ptkf_setintcolour(wsid, colourname)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{CHARACTER*(*)}{colourname}{colour name}{IN}
C ** \paramend
C ** \blurb{This function sets the interior colour index to be
C ** that specified by the given
C ** colour name in the {\tt "colourindex"} hashtable. The colour 
C ** representation is set in the workstation colour table if necessary.}
C */
       INTEGER wsid
       CHARACTER*(*) colourname
       external ptk_setintcolour !$PRAGMA C(ptk_setintcolour)

       call ptk_setintcolour(%val(wsid), colourname)

       RETURN
       END

       SUBROUTINE ptkf_setedgecolour(wsid, colourname)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{CHARACTER*(*)}{colourname}{colour name}{IN}
C ** \paramend
C ** \blurb{This function sets the edge colour index to be 
C ** that specified by the given
C ** colour name in the {\tt "colourindex"} hashtable. The colour 
C ** representation is set in the workstation colour table if necessary.}
C */
       INTEGER wsid
       CHARACTER*(*) colourname
       external ptk_setedgecolour !$PRAGMA C(ptk_setedgecolour)

       call ptk_setedgecolour(%val(wsid), colourname)

       RETURN
       END

       SUBROUTINE ptkf_settextcolour(wsid, colourname)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{CHARACTER*(*)}{colourname}{colour name}{IN}
C ** \paramend
C ** \blurb{This function sets the text colour index to be 
C ** that specified by the given
C ** colour name in the {\tt "colourindex"} hashtable. The colour 
C ** representation is set in the workstation colour table if necessary.}
C */
       INTEGER wsid
       CHARACTER*(*) colourname
       external ptk_settextcolour !$PRAGMA C(ptk_settextcolour)

       call ptk_settextcolour(%val(wsid), colourname)

       RETURN
       END

C end of cns.f

